Developer CD Series 1996 May: Tool Chest/Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso/Sample Code/Snippets/Printing/PicCommentsTest/TN91TestCode.p

Text File | 1992-06-11 | 7.0 KB | 315 lines | [TEXT/PJMM]

program TN91TestCode;
    uses
        PrintTraps, PicComments, Globals, TestPicComments;


    procedure DrawContents (frame: Rect; p: GrafPtr);
        var
            savePort: GrafPtr;
            s: Str255;
    begin  {DrawContents}
        GetPort(savePort);
        SetPort(p);
        case gWhichDemo of
            iNone:
                begin
                    TextFont(applFont);
                    TextSize(12);
                    TextFace([]);
                    GetIndString(s, rStrings, iSuggestSelection);
                    MoveTo(30, 30);
                    DrawString(s);
                end;
            iTextRotation:
                TextRotationDemo;
            iLineLayout:
                LineLayoutDemo;
            iPolygon:
                PolygonDemo(gFilled, gClosed);
            iDashedLine:
                DashDemo;
            iLineWidth:
                LineWidthDemo;
            iGraphicsRot:
                GraphRotDemo;
            iPostScript:
                PostScriptComments;
        end;
        SetPort(savePort);
    end; {DrawContents}


    procedure DoPageSetup;
    begin
        PrOpen;
        if PrStlDialog(gPrRec) then
            ; { nothing }
        PrClose;
    end; { DoPageSetup }


    procedure PrintTestPage;
        var
            theStatus: TPrStatus;
            goPrinting: Boolean;
    begin
        PrOpen;
        goPrinting := TRUE;
        if PrValidate(gPrRec) then
            goPrinting := PrStlDialog(gPrRec);
        if goPrinting & PrJobDialog(gPrRec) then
            begin
                DrawContents(gWP^.portRect, gWP);
                gPrPort := PrOpenDoc(gPrRec, gPrPort, nil);
                if PrError = noErr then
                    begin
                        PrOpenPage(gPrPort, nil);
                        if PrError = noErr then
                            DrawContents(gPrRec^^.prInfo.rPage, @gPrPort^.gPort);
                        PrClosePage(gPrPort);
                    end;
                PrCloseDoc(gPrPort);
                if (gPrRec^^.prJob.bJDocLoop = bSpoolLoop) and (PrError = noErr) then
                    PrPicFile(gPrRec, nil, nil, nil, theStatus);
            end;
        PrClose;
    end; { PrintTestPage }


    procedure MyItem (dlg: DialogPtr; itemNo: Integer);  { frame OK button }
        var
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;
    begin
        GetDItem(dlg, itemNo, itemType, itemHandle, itemRect);
        PenSize(3, 3);
        InsetRect(itemRect, -4, -4);
        FrameRoundRect(itemRect, 16, 16);
        PenSize(1, 1);
    end;  { MyItem }


    function MyFilter (dlg: DialogPtr; var event: EventRecord; var itemHit: Integer): Boolean;
{ intercept return, enter and escape keys in modal dialog }
        var
            key: Char;
            itemRect: Rect;
            itemType: Integer;
            itemHandle: Handle;
            ticks: Longint;
            state: Integer;

        procedure ButtonFeedBack;
        begin
            GetDItem(dlg, itemHit, itemType, itemHandle, itemRect);
            HiliteControl(ControlHandle(itemHandle), 1);
            Delay(8, ticks);
            HiliteControl(ControlHandle(itemHandle), 0);
        end;

    begin
        MyFilter := false;
        case event.what of
            keyDown, autoKey:
                begin
                    key := chr(BitAnd(event.message, charCodeMask));
                    if (ord(key) = 13) | (ord(key) = 3) then
                        begin
                            itemHit := ok;
                            ButtonFeedBack;
                            MyFilter := true;
                        end
                    else if ord(key) = 27 then
                        begin
                            itemHit := cancel;
                            ButtonFeedBack;
                            MyFilter := true;
                        end;
                end;
        end; {case}
    end;  {MyFilter}


    procedure UpdateCheckBoxes (dlg: DialogPtr);  { in PolygonSmoothing dlg }
        var
            itemRect: Rect;
            itemType: Integer;
            itemHandle: Handle;
    begin
        GetDItem(dlg, iFilled, itemType, itemHandle, itemRect);
        SetCtlValue(ControlHandle(itemHandle), ord(gFilled));
        GetDItem(dlg, iClosed, itemType, itemHandle, itemRect);
        SetCtlValue(ControlHandle(itemHandle), ord(gClosed));
    end;


    procedure UpdateRadioButtons (dlg: DialogPtr); { in TextRotation dlg }
        var
            i: Integer;
            itemRect: Rect;
            itemType: Integer;
            itemHandle: Handle;
    begin
        for i := iJNone to iJFull do
            begin
                GetDItem(dlg, i, itemType, itemHandle, itemRect);
                SetCtlValue(ControlHandle(itemHandle), ord(gJus = (i - iJNone)));
            end;
        for i := iFNone to iFVertic do
            begin
                GetDItem(dlg, i, itemType, itemHandle, itemRect);
                SetCtlValue(ControlHandle(itemHandle), ord(gFlip = (i - iFNone)));
            end;
    end;


    procedure DoDemo (whichDemo: Integer);
        var
            dlg: DialogPtr;
            savePort: GrafPtr;
            itemHit: Integer;
            itemRect: Rect;
            itemType: Integer;
            itemHandle: Handle;
            s: Str255;
    begin
        GetPort(savePort);
        itemHit := ok;
        case whichDemo of
            iTextRotation:
                begin
                    dlg := GetNewDialog(rTxtPicOptions, nil, WindowPtr(-1));
                    if dlg = nil then
                        DebugStr('GetNewDialog failed');
                    SetPort(GrafPtr(dlg));
                    GetDItem(dlg, iOKUser, itemType, itemHandle, itemRect);
                    SetDItem(dlg, iOKUser, itemType, @MyItem, itemRect);
                    repeat
                        UpdateRadioButtons(dlg);
                        ModalDialog(@MyFilter, itemHit);
                        case itemHit of
                            iJNone:
                                gJus := tJusNone;
                            iJLeft:
                                gJus := tJusLeft;
                            iJCenter:
                                gJus := tJusCenter;
                            iJRight:
                                gJus := tJusRight;
                            iJFull:
                                gJus := tJusFull;
                            iFNone:
                                gFlip := tFlipNone;
                            iFHoriz:
                                gFlip := tFlipHorizontal;
                            iFVertic:
                                gFlip := tFlipVertical;
                        end;
                    until itemHit in [ok, cancel];
                    DisposDialog(dlg);
                end;
            iPolygon:
                begin
                    dlg := GetNewDialog(rPolyOptions, nil, WindowPtr(-1));
                    if dlg = nil then
                        DebugStr('GetNewDialog failed');
                    SetPort(GrafPtr(dlg));
                    GetDItem(dlg, iUser, itemType, itemHandle, itemRect);
                    SetDItem(dlg, iUser, itemType, @MyItem, itemRect);
                    repeat
                        UpdateCheckBoxes(dlg);
                        ModalDialog(@MyFilter, itemHit);
                        if itemHit = iFilled then
                            gFilled := not gFilled;
                        if itemHit = iClosed then
                            gClosed := not gClosed;
                    until itemHit in [ok, cancel];
                    DisposDialog(dlg);
                end;
        end;
        if itemHit = cancel then
            exit(DoDemo);
        gWhichDemo := whichDemo;
        GetItem(GetMHandle(mSelect), gWhichDemo, s);
        SetWTitle(gWP, s);
        SetPort(gWP);
        EraseRect(gWP^.portRect);
        InvalRect(gWP^.portRect);
        SetPort(savePort);
    end;


    procedure DoMenuCommand (menuResult: Longint);
        var
            menuID, menuItem: Integer;
            daRefNum, itemHit: Integer;
            s: Str255;
    begin
        menuID := HiWrd(menuResult);
        menuItem := LoWrd(menuResult);
        case menuID of
            mApple:
                if menuItem = iAbout then
                    itemHit := Alert(rAboutAlert, nil)
                else
                    begin
                        GetItem(GetMHandle(mApple), menuItem, s);
                        daRefNum := OpenDeskAcc(s);
                    end;
            mFile:
                case menuItem of
                    iPageSetup:
                        DoPageSetup;
                    iPrint:
                        PrintTestPage;
                    iQuit:
                        gDone := TRUE;
                end;
            mSelect:
                DoDemo(menuItem);
        end;
        HiliteMenu(0);
    end;    { DoMenuCommand }


    procedure EventLoop;
        var
            evt: EventRecord;
            wnd: WindowPtr;
    begin
        repeat
            if WaitNextEvent(everyEvent, evt, 60, nil) then
                case evt.what of
                    mouseDown:
                        begin
                            case FindWindow(evt.where, wnd) of
                                inMenuBar:
                                    DoMenuCommand(MenuSelect(evt.where));
                                inSysWindow:
                                    SystemClick(evt, wnd);
                                inGoAway:
                                    gDone := TRUE;
                                inDrag:
                                    DragWindow(wnd, evt.where, screenBits.bounds);
                            end;
                        end;
                    keyDown:
                        if BAnd(evt.modifiers, cmdKey) <> 0 then
                            DoMenuCommand(MenuKey(CHR(BAnd(evt.message, charCodeMask))));
                    updateEvt:
                        begin
                            BeginUpdate(gWP);
                            DrawContents(gWP^.portRect, gWP);
                            EndUpdate(gWP);
                        end;
                end;
        until gDone;
    end;    { EventLoop}


begin { TN91TestCode}
    InitMac;
    InitApp;
    EventLoop;
end.    { TN91TestCode}